home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / himetr1r / ctlcolou.ctl < prev    next >
Text File  |  1999-08-14  |  32KB  |  917 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.UserControl ctlColour 
  4.    ClientHeight    =   1485
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   1860
  8.    ScaleHeight     =   1485
  9.    ScaleWidth      =   1860
  10.    Begin RichTextLib.RichTextBox rtfMain 
  11.       Height          =   1455
  12.       Left            =   0
  13.       TabIndex        =   1
  14.       Top             =   0
  15.       Width           =   1815
  16.       _ExtentX        =   3201
  17.       _ExtentY        =   2566
  18.       _Version        =   393217
  19.       ScrollBars      =   3
  20.       TextRTF         =   $"ctlColour.ctx":0000
  21.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  22.          Name            =   "Courier New"
  23.          Size            =   9.75
  24.          Charset         =   0
  25.          Weight          =   400
  26.          Underline       =   0   'False
  27.          Italic          =   0   'False
  28.          Strikethrough   =   0   'False
  29.       EndProperty
  30.    End
  31.    Begin RichTextLib.RichTextBox rtfTemp 
  32.       Height          =   855
  33.       Left            =   2400
  34.       TabIndex        =   0
  35.       Top             =   1320
  36.       Visible         =   0   'False
  37.       Width           =   975
  38.       _ExtentX        =   1720
  39.       _ExtentY        =   1508
  40.       _Version        =   393217
  41.       ScrollBars      =   3
  42.       TextRTF         =   $"ctlColour.ctx":00C8
  43.    End
  44. End
  45. Attribute VB_Name = "ctlColour"
  46. Attribute VB_GlobalNameSpace = False
  47. Attribute VB_Creatable = True
  48. Attribute VB_PredeclaredId = False
  49. Attribute VB_Exposed = False
  50. '----------------------------------------
  51. '- Name: Sam Huggill
  52. '- Email: sam@vbsquare.com
  53. '- Web: http://www.vbsquare.com/
  54. '- Company: Lighthouse Internet Solutions
  55. '- Date/Time: 14/08/99 11:26:38
  56. '----------------------------------------
  57. '- Notes:   Automatically colourizes code
  58. '           Written by James Crowley -
  59. '           www.vbweb.f9.co.uk
  60. '----------------------------------------
  61.  
  62. Option Explicit
  63.  
  64. Private m_ColourComment As OLE_COLOR
  65. Private m_ColourKeyword As OLE_COLOR
  66. Private m_ColourText As OLE_COLOR
  67.  
  68. Private m_strBlackKeywords As String
  69. Private m_strBlueKeywords As String
  70.  
  71. Private m_intSelPos As Integer
  72. Private m_intSelLen As Integer
  73. Private m_blnBusy As Boolean
  74. Private m_blnChanged As Boolean
  75.  
  76. Private m_intNextLine As Integer
  77. Private m_intLastLine As Integer
  78. Private m_intLastLinePos As Integer
  79.  
  80. 'Default Property Values:
  81. Const m_def_AutoVerbMenu = 0
  82. Const m_def_BulletIndent = 0
  83. Const m_def_DisableNoScroll = 0
  84. Const m_def_FileName = ""
  85. Const m_def_Locked = 0
  86. Const m_def_MultiLine = 0
  87. Const m_def_OLEDragMode = 0
  88. Const m_def_RightMargin = 0
  89. Const m_def_ScrollBars = 0
  90. Const m_def_Text = ""
  91. Const m_def_ToolTipText = ""
  92. Const m_def_ColourComment = 0
  93. Const m_def_ColourKeyword = 0
  94. Const m_def_ColourText = 0
  95. 'Property Variables:
  96. Dim m_AutoVerbMenu As Boolean
  97. Dim m_BulletIndent As Single
  98. Dim m_DisableNoScroll As Boolean
  99. Dim m_FileName As String
  100. Dim m_Locked As Boolean
  101. Dim m_MultiLine As Boolean
  102. Dim m_OLEDragMode As OLEDragConstants
  103. Dim m_RightMargin As Single
  104. Dim m_ScrollBars As ScrollBarsConstants
  105. Dim m_Text As String
  106. Dim m_ToolTipText As String
  107. Dim m_blnColour As Boolean
  108. 'Event Declarations:
  109. Event Change()
  110. Event Click()
  111. Event DblClick()
  112. Event OLECompleteDrag(Effect As Long)
  113. Event OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  114. Event OLEDragOver(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  115. Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
  116. Event OLESetData(Data As RichTextLib.DataObject, DataFormat As Integer)
  117. Event OLEStartDrag(Data As RichTextLib.DataObject, AllowedEffects As Long)
  118. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  119. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  120. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  121. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  122. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  123. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  124. Event SelChange()
  125.  
  126.  
  127. Public Property Get Font() As Font
  128.     Set Font = rtfMain.Font
  129. End Property
  130.  
  131. Public Property Set Font(ByVal New_Font As Font)
  132.     Set rtfMain.Font = New_Font
  133.     Set rtfTemp.Font = New_Font
  134.     PropertyChanged "Font"
  135. End Property
  136.  
  137. Public Property Get ColourComment() As OLE_COLOR
  138.     ColourComment = m_ColourComment
  139. End Property
  140.  
  141. Public Property Let ColourComment(ByVal New_ColourComment As OLE_COLOR)
  142.     m_ColourComment = New_ColourComment
  143.     PropertyChanged "ColourComment"
  144. End Property
  145.  
  146. Public Property Get ColourKeyword() As OLE_COLOR
  147.     ColourKeyword = m_ColourKeyword
  148. End Property
  149.  
  150. Public Property Let ColourKeyword(ByVal New_ColourKeyword As OLE_COLOR)
  151.     m_ColourKeyword = New_ColourKeyword
  152.     PropertyChanged "ColourKeyword"
  153. End Property
  154.  
  155. Public Property Get ColourText() As OLE_COLOR
  156.     ColourText = m_ColourText
  157. End Property
  158.  
  159. Public Property Let ColourText(ByVal New_ColourText As OLE_COLOR)
  160.     m_ColourText = New_ColourText
  161.     PropertyChanged "ColourText"
  162. End Property
  163.  
  164. Public Sub Initalize()
  165.     '// Initalize the words that need to be coloured
  166.     m_strBlackKeywords = "*Abs*Add*AddItem*AppActivate*Array*Asc*Atn*Beep*Begin*BeginProperty*ChDir*ChDrive*Choose*Chr*Clear*Collection*Command*Cos*CreateObject*CurDir*DateAdd*DateDiff*DatePart*DateSerial*DateValue*Day*DDB*DeleteSetting*Dir*DoEvents*EndProperty*Environ*EOF*Err*Exp*FileAttr*FileCopy*FileDateTime*FileLen*Fix*Format*FV*GetAllSettings*GetAttr*GetObject*GetSetting*Hex*Hide*Hour*InputBox*InStr*Int*Int*IPmt*IRR*IsArray*IsDate*IsEmpty*IsError*IsMissing*IsNull*IsNumeric*IsObject*Item*Kill*LCase*Left*Len*Load*Loc*LOF*Log*LTrim*Me*Mid*Minute*MIRR*MkDir*Month*Now*NPer*NPV*Oct*Pmt*PPmt*PV*QBColor*Raise*Randomize*Rate*Remove*RemoveItem*Reset*RGB*Right*RmDir*Rnd*RTrim*SaveSetting*Second*SendKeys*SetAttr*Sgn*Shell*Sin*Sin*SLN*Space*Sqr*Str*StrComp*StrConv*Switch*SYD*Tan*Text*Time*Time*Timer*TimeSerial*TimeValue*Trim*TypeName*UCase*Unload*Val*VarType*WeekDay*Width*Year*"
  167.     m_strBlueKeywords = "*#Const*#Else*#ElseIf*#End If*#If*Alias*Alias*And*As*Base*Binary*Boolean*Byte*ByVal*Call*Case*CBool*CByte*CCur*CDate*CDbl*CDec*CInt*CLng*Close*Compare*Const*CSng*CStr*Currency*CVar*CVErr*Decimal*Declare*DefBool*DefByte*DefCur*DefDate*DefDbl*DefDec*DefInt*DefLng*DefObj*DefSng*DefStr*DefVar*Dim*Do*Double*Each*Else*ElseIf*End*Enum*Eqv*Erase*Error*Exit*Explicit*False*For*Function*Get*Global*GoSub*GoTo*If*Imp*In*Input*Input*Integer*Is*LBound*Let*Lib*Like*Line*Lock*Long*Loop*LSet*Name*New*Next*Not*Object*On*Open*Option*Or*Output*Print*Private*Property*Public*Put*Random*Read*ReDim*Resume*Return*RSet*Seek*Select*Set*Single*Spc*Static*String*Stop*Sub*Tab*Then*Then*True*Type*UBound*Unlock*Variant*Wend*While*With*Xor*Nothing*To*"
  168. End Sub
  169.  
  170. Public Sub Colour(rtf As Object, blnAll As Boolean)
  171.  
  172.     Dim strText As String
  173.     Dim intSelLen As Long
  174.  
  175.     If blnAll = True Then
  176.         '// If we want to colour the whole thing,
  177.         '// go to the end
  178.         rtfTemp.TextRTF = rtf.TextRTF
  179.         GoTo TheRest
  180.     End If
  181.     '// Copy the text into our tempory text box, colour it and
  182.     '// return the text to the original text box
  183.  
  184.     strText = GetLineText(rtf)
  185.     If strText = "-1" Then
  186.         Exit Sub
  187.     End If
  188.     rtfTemp.Text = strText
  189.  
  190. TheRest:
  191.     '// Delete the line
  192.     If rtf.SelText Like "vbcrlf*" Then
  193.         intSelLen = rtf.SelLength
  194.         rtf.SelStart = rtf.SelStart + 2
  195.         rtf.SelLength = intSelLen - 2
  196.     ElseIf rtf.SelText Like "*vbcrlf" Then
  197.         rtf.SelLength = rtf.SelLength - 2
  198.     End If
  199.     rtf.SelText = ""
  200.     If rtfTemp.Text = "" Then